home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / xscm.lha / xscm / xm.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-29  |  9.8 KB  |  403 lines
  1. /*
  2.  * $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/xm.c,v 1.5 1992/08/10 22:48:49 campbell Beta $
  3.  *
  4.  * Author: Larry Campbell (campbell@redsox.bsw.com)
  5.  *
  6.  * Copyright 1992 by The Boston Software Works, Inc.
  7.  * Permission to use for any purpose whatsoever granted, as long
  8.  * as this copyright notice remains intact.  Please send bug fixes
  9.  * or enhancements to the above email address.
  10.  *
  11.  * Class and function definitions for scm interface to Motif toolkit
  12.  */
  13.  
  14. #include <stdio.h>
  15. #include <X11/Intrinsic.h>
  16. #include <X11/Shell.h>
  17. #include <X11/StringDefs.h>
  18. #include <Xm/Xm.h>
  19. #include <Xm/ArrowB.h>
  20. #include <Xm/ArrowBG.h>
  21. #include <Xm/BulletinB.h>
  22. #include <Xm/CascadeB.h>
  23. #include <Xm/CascadeBG.h>
  24. #include <Xm/DialogS.h>
  25. #include <Xm/DrawingA.h>
  26. #include <Xm/DrawnB.h>
  27. #include <Xm/FileSB.h>
  28. #include <Xm/Form.h>
  29. #include <Xm/Frame.h>
  30. #include <Xm/Label.h>
  31. #include <Xm/LabelG.h>
  32. #include <Xm/List.h>
  33. #include <Xm/MainW.h>
  34. #include <Xm/MenuShell.h>
  35. #include <Xm/MessageB.h>
  36. #include <Xm/PanedW.h>
  37. #include <Xm/PushB.h>
  38. #include <Xm/PushBG.h>
  39. #include <Xm/RowColumn.h>
  40. #include <Xm/Scale.h>
  41. #include <Xm/ScrollBar.h>
  42. #include <Xm/ScrolledW.h>
  43. #include <Xm/SelectioB.h>
  44. #include <Xm/Separator.h>
  45. #include <Xm/SeparatoG.h>
  46. #include <Xm/Text.h>
  47. #include <Xm/TextF.h>
  48. #include <Xm/ToggleB.h>
  49. #include <Xm/ToggleBG.h>
  50.  
  51. #include "scm.h"
  52. #include "x.h"
  53. #include "xt.h"
  54.  
  55. static char    s_xm_create_popup_menu[]    = "xm:create-popup-menu";
  56. static char    s_xm_create_pulldown_menu[]    = "xm:create-pulldown-menu";
  57. static char    s_xm_list_delete_item[]        = "xm:list-delete-item";
  58. static char    s_xm_list_deselect_all_items[]    = "xm:list-deselect-all-items";
  59. static char    s_xm_menu_position[]        = "xm:menu-position";
  60. static char    s_xm_string_create[]        = "xm:string-create";
  61. static char    s_xm_string_get_first_segment[]    = "xm:string-get-first-segment";
  62. static char    s_xm_text_get_string[]        = "xm:text-get-string";
  63. static char    s_xm_vector_to_xmstringtable[]    = "xm:vector->xmstringtable";
  64. static char    s_xm_xmstringp[]        = "xm:xmstring?";
  65. static char    s_xm_xmstringtablep[]        = "xm:xmstringtable?";
  66. static char    s_xm_xmstringtable_to_vector[]    = "xm:xmstringtable->vector";
  67.  
  68. xt_widget_class_t xm_widget_classes[] = {
  69.     "xm:arrow-button",        &xmArrowButtonWidgetClass,
  70.     "xm:arrow-button-gadget",    &xmArrowButtonGadgetClass,
  71.     "xm:bulletin-board",    &xmBulletinBoardWidgetClass,
  72.     "xm:cascade-button",    &xmCascadeButtonWidgetClass,
  73.     "xm:cascade-button-gadget",    &xmCascadeButtonGadgetClass,
  74.     "xm:dialog-shell",        &xmDialogShellWidgetClass,
  75.     "xm:drawing-area",        &xmDrawingAreaWidgetClass,
  76.     "xm:drawn-button",        &xmDrawnButtonWidgetClass,
  77.     "xm:file-selection-box",    &xmFileSelectionBoxWidgetClass,
  78.     "xm:form",            &xmFormWidgetClass,
  79.     "xm:frame",            &xmFrameWidgetClass,
  80.     "xm:gadget",        &xmGadgetClass,
  81.     "xm:label",            &xmLabelWidgetClass,
  82.     "xm:label-gadget",        &xmLabelGadgetClass,
  83.     "xm:list",            &xmListWidgetClass,
  84.     "xm:main-window",        &xmMainWindowWidgetClass,
  85.     "xm:menu-shell",        &xmMenuShellWidgetClass,
  86.     "xm:message-box",        &xmMessageBoxWidgetClass,
  87.     "xm:paned-window",        &xmPanedWindowWidgetClass,
  88.     "xm:push-button",        &xmPushButtonWidgetClass,
  89.     "xm:push-button-gadget",    &xmPushButtonGadgetClass,
  90.     "xm:row-column",        &xmRowColumnWidgetClass,
  91.     "xm:scale",            &xmScaleWidgetClass,
  92.     "xm:scroll-bar",        &xmScrollBarWidgetClass,
  93.     "xm:scrolled-window",    &xmScrolledWindowWidgetClass,
  94.     "xm:selection-box",        &xmSelectionBoxWidgetClass,
  95.     "xm:separator",        &xmSeparatorWidgetClass,
  96.     "xm:separator-gadget",    &xmSeparatorGadgetClass,
  97.     "xm:text",            &xmTextWidgetClass,
  98.     "xm:text-field",        &xmTextFieldWidgetClass,
  99.     "xm:toggle-button",        &xmToggleButtonWidgetClass,
  100.     "xm:toggle-button-gadget",    &xmToggleButtonGadgetClass,
  101.     "xm:vendor-shell",        &vendorShellWidgetClass
  102. };
  103.  
  104. extern void xt__make_arglist();
  105.  
  106. static sizet xm_free_xmstring();
  107. static sizet xm_free_xmstringtable();
  108.  
  109. /*
  110.  * Scheme types defined in this module
  111.  */
  112.  
  113. #define XM_SMOBS                            \
  114. XX(xmstring,        mark_no_further,    xm_free_xmstring)    \
  115. XX(xmstringtable,    mark_no_further,    xm_free_xmstringtable)
  116.  
  117. #undef XX
  118. #define XX(name, mark, free)            \
  119. long TOKEN_PASTE(tc16_,name);            \
  120. static int TOKEN_PASTE(print_,name)();        \
  121. static smobfuns TOKEN_PASTE(smob,name) =    \
  122.     { mark, free, TOKEN_PASTE(print_,name) };
  123.  
  124. XM_SMOBS
  125.  
  126.  
  127. SCM make_xmstring()
  128. {
  129.   SCM s;
  130.   NEWCELL(s);
  131.   CAR(s) = tc16_xmstring;
  132.   CDR(s) = 0;
  133.   return s;
  134. }
  135.  
  136. SCM make_xmstringtable(len)
  137. int len;
  138. {
  139.   SCM v;
  140.   XmString *p;
  141.  
  142.   NEWCELL(v);
  143.   DEFER_INTS;
  144.   SET_XMSTRINGTABLE_LENGTH(v,len,tc16_xmstringtable);
  145.   SETCHARS(v,must_malloc(len*sizeof(XmString),"make_xmstringtable"));
  146.   p = (XmString *) CDR(v);
  147.   while(--len>=0)
  148.     p[len] = 0;
  149.   ALLOW_INTS;
  150.   return v;
  151. }
  152.  
  153. static sizet xm_free_xmstring(ptr)
  154. SCM ptr;
  155. {
  156.   sizet n = XmStringLength(XMSTRING(ptr));
  157.   XmStringFree(XMSTRING(ptr));
  158.   return n;
  159. }
  160.  
  161. static sizet xm_free_xmstringtable(ptr)
  162. SCM ptr;
  163. {
  164.   int i;
  165.   sizet n = 0;
  166.   XmString *p = (XmString *) CDR(ptr);
  167.  
  168.   for (i = 0; i < XMSTRINGTABLE_LENGTH(ptr); i++) {
  169.     n += XmStringLength(p[i]);
  170.     XmStringFree(p[i]);
  171.   }
  172.   return n;
  173. }
  174.  
  175. SCM xm_text_get_string(sw)
  176. SCM sw;
  177. {
  178.   char *p;
  179.   SCM s;
  180.  
  181.   ASSERT(NIMP(sw) && WIDGETP(sw),sw,ARG1,s_xm_text_get_string);
  182.   p = XmTextGetString(WIDGET(sw));
  183.   s = makfromstr(p, strlen(p));
  184.   XtFree(p);
  185.   return s;
  186. }
  187.  
  188.  
  189. SCM xm_create_popup_menu(sparent, sname, args)
  190. SCM sparent, sname, args;
  191. {
  192.   char *name;
  193.   ArgList arglist;
  194.   int n;
  195.   Widget w;
  196.  
  197.   ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG1, s_xm_create_popup_menu);
  198.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xm_create_popup_menu);
  199.   name = CHARS(sname);
  200.   xt__make_arglist(args, &arglist, &n, s_xm_create_popup_menu);
  201.  
  202.   w = XmCreatePopupMenu(WIDGET(sparent), name, arglist, n);
  203.  
  204.   return make_widget(w);
  205. }
  206.  
  207.  
  208. SCM xm_create_pulldown_menu(sparent, sname, args)
  209. SCM sparent, sname, args;
  210. {
  211.   char *name;
  212.   ArgList arglist;
  213.   int n;
  214.   Widget w;
  215.   SCM sw;
  216.  
  217.   ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG1, s_xm_create_pulldown_menu);
  218.   ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xm_create_pulldown_menu);
  219.   name = CHARS(sname);
  220.   xt__make_arglist(args, &arglist, &n, s_xm_create_pulldown_menu);
  221.  
  222.   w = XmCreatePulldownMenu(WIDGET(sparent), name, arglist, n);
  223.  
  224.   return make_widget(w);
  225. }
  226.  
  227.  
  228. SCM xm_list_delete_item(sw, ss)
  229. SCM sw, ss;
  230. {
  231.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_list_delete_item);
  232.   ASSERT(NIMP(ss) && XMSTRINGP(ss), ss, ARG2, s_xm_list_delete_item);
  233.   XmListDeleteItem(WIDGET(sw), XMSTRING(ss));
  234. }
  235.  
  236.  
  237. SCM xm_list_deselect_all_items(sw, ss)
  238. SCM sw, ss;
  239. {
  240.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_list_deselect_all_items);
  241.   XmListDeselectAllItems(WIDGET(sw));
  242. }
  243.  
  244.  
  245. SCM xm_menu_position(sw, se)
  246. SCM sw, se;
  247. {
  248.   XButtonPressedEvent *e;
  249.  
  250.   ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_menu_position);
  251.   ASSERT(NIMP(se) && XEVENTP(se), se, ARG2, s_xm_menu_position);
  252.   e = (XButtonPressedEvent *) XEVENT(se);
  253.   XmMenuPosition(WIDGET(sw), e);
  254.   return UNSPECIFIED;
  255. }
  256.  
  257.  
  258. SCM xm_string_create(str)
  259. SCM str;
  260. {
  261.   SCM s;
  262.  
  263.   ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_xm_string_create);
  264.   s = make_xmstring();
  265.   SETCDR(s, XmStringCreateLtoR(CHARS(str), XmSTRING_DEFAULT_CHARSET));
  266.  
  267.   return s;
  268. }
  269.  
  270.  
  271. SCM xm_xmstringp(x)
  272. SCM x;
  273. {
  274.   if (NIMP(x) && XMSTRINGP(x))
  275.     return BOOL_T;
  276.   else
  277.     return BOOL_F;
  278. }
  279.  
  280.  
  281. SCM xm_xmstringtablep(x)
  282. SCM x;
  283. {
  284.   if (NIMP(x) && XMSTRINGTABLEP(x))
  285.     return BOOL_T;
  286.   else
  287.     return BOOL_F;
  288. }
  289.  
  290.  
  291. SCM xm_string_get_first_segment(sstr)
  292. SCM sstr;
  293. {
  294.   XmString str;
  295.   char *p;
  296.   SCM s;
  297.  
  298.   ASSERT(NIMP(sstr) && XMSTRINGP(sstr), sstr, ARG1, s_xm_string_get_first_segment);
  299.   XmStringGetLtoR(XMSTRING(sstr), XmSTRING_DEFAULT_CHARSET, &p);
  300.   s = makfromstr(p, strlen(p));
  301.   return s;
  302. }
  303.  
  304.  
  305. SCM xm_xmstringtable_to_vector(sl)
  306. SCM sl;
  307. {
  308.   int i, len;
  309.   SCM v, s;
  310.  
  311.   ASSERT(NIMP(sl) && XMSTRINGTABLEP(sl), sl, ARG1, s_xm_xmstringtable_to_vector);
  312.   len = XMSTRINGTABLE_LENGTH(sl);
  313.   if (len == 0) return nullvect;
  314.   v = make_vector(MAKINUM((long) len), UNDEFINED);
  315.   for (i = 0; i < len; i++) {
  316.     s = make_xmstring();
  317.     SETCDR(s, XmStringCopy(XMSTRINGTABLE(sl)[i]));
  318.     VELTS(v)[i] = s;
  319.   }
  320.   return v;
  321. }
  322.  
  323. SCM xm_vector_to_xmstringtable(sv)
  324. SCM sv;
  325. {
  326.   SCM sl, s;
  327.   int i, len;
  328.   XmStringTable p;
  329.  
  330.   ASSERT(NIMP(sv) && VECTORP(sv), sv, ARG1, s_xm_vector_to_xmstringtable);
  331.   len = LENGTH(sv);
  332.   sl = make_xmstringtable(len);
  333.   p = XMSTRINGTABLE(sl);
  334.   for (i = 0; i < len; i++) {
  335.     s = VELTS(sv)[i];
  336.     ASSERT(NIMP(s) && XMSTRINGP(s), s, "vector elements must be XmStrings", s_xm_vector_to_xmstringtable);
  337.     p[i] = XmStringCopy(XMSTRING(s));
  338.   }
  339.   return sl;  
  340. }
  341.  
  342.  
  343. static int print_xmstring(exp, f, writing)
  344. SCM exp;
  345. FILE *f;
  346. int writing;
  347. {
  348.   lputs("#<XmString>", f);
  349.   return 1;
  350. }
  351.  
  352. static int print_xmstringtable(exp, f, writing)
  353. SCM exp;
  354. FILE *f;
  355. int writing;
  356. {
  357.   lputs("#<XmStringTable of ", f);
  358.   intprint(XMSTRINGTABLE_LENGTH(exp), 10, f);
  359.   lputc('>',f);
  360.   return 1;
  361. }
  362.  
  363.  
  364. iproc xm_lsubr2s[] = {
  365.   {s_xm_create_popup_menu,    xm_create_popup_menu},
  366.   {s_xm_create_pulldown_menu,    xm_create_pulldown_menu},
  367.   {0, 0}
  368. };
  369.  
  370. iproc xm_subr2s[] = {
  371.   {s_xm_list_delete_item,        xm_list_delete_item},
  372.   {s_xm_menu_position,            xm_menu_position},
  373.   {0, 0}
  374. };
  375.  
  376. iproc xm_subr1s[] = {
  377.   {s_xm_list_deselect_all_items,    xm_list_deselect_all_items},
  378.   {s_xm_string_create,            xm_string_create},
  379.   {s_xm_string_get_first_segment,    xm_string_get_first_segment},
  380.   {s_xm_text_get_string,        xm_text_get_string},
  381.   {s_xm_xmstringp,            xm_xmstringp},
  382.   {s_xm_xmstringtablep,            xm_xmstringtablep},
  383.   {s_xm_xmstringtable_to_vector,    xm_xmstringtable_to_vector},
  384.   {s_xm_vector_to_xmstringtable,    xm_vector_to_xmstringtable},
  385.   {0, 0}
  386. };
  387.  
  388. #undef XX
  389. #define XX(name, mark, free) \
  390.     TOKEN_PASTE(tc16_,name) = newsmob(&TOKEN_PASTE(smob,name));
  391.  
  392. void init_xm()
  393. {
  394.   init_iprocs(xm_lsubr2s, tc7_lsubr_2);
  395.   init_iprocs(xm_subr2s,  tc7_subr_2);
  396.   init_iprocs(xm_subr1s,  tc7_subr_1);
  397.   XM_SMOBS
  398.   xt_init_widget_classes(
  399.     xm_widget_classes,
  400.     XtNumber(xm_widget_classes),
  401.     "*motif-widget-classes*");
  402. }
  403.